library(plotly)
library(here)
library(tidyverse)
library(magick)
library(rmdformats)Breed_Traits <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-02-01/breed_traits.csv')
Breed_Traits <- read_csv(here("Data","Breed_Traits.csv")) # Load first data set
head(Breed_Traits)## # A tibble: 6 × 18
## Breed Breed…¹ Affec…² Good …³ Good …⁴ Shedd…⁵ Coat …⁶ Drool…⁷ Coat …⁸ Coat …⁹
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Retri… Sporti… 5 5 5 4 2 2 Double Short
## 2 Frenc… Non-sp… 5 5 4 3 1 3 Smooth Short
## 3 Germa… Herding 5 5 3 4 2 2 Double Medium
## 4 Retri… Sporti… 5 5 5 4 2 2 Double Medium
## 5 Bulld… Non-sp… 4 3 3 3 3 3 Smooth Short
## 6 Poodl… Non-sp… 5 5 3 1 4 1 Curly Long
## # … with 8 more variables: `Openness To Strangers` <dbl>,
## # `Playfulness Level` <dbl>, `Watchdog/Protective Nature` <dbl>,
## # `Adaptability Level` <dbl>, `Trainability Level` <dbl>,
## # `Energy Level` <dbl>, `Barking Level` <dbl>,
## # `Mental Stimulation Needs` <dbl>, and abbreviated variable names
## # ¹`Breed Group`, ²`Affectionate With Family`, ³`Good With Young Children`,
## # ⁴`Good With Other Dogs`, ⁵`Shedding Level`, ⁶`Coat Grooming Frequency`, …
AKC_Breed_Info <- read_csv(here("Data","AKC_Breed_Info.csv")) # Load second data set
head(AKC_Breed_Info)## # A tibble: 6 × 5
## Breed height_low_inches height_high_inches weight_low…¹ weigh…²
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Akita 26 28 80 120
## 2 Anatolian Sheepdog 27 29 100 150
## 3 Bernese Mountain Dog 23 27 85 110
## 4 Bloodhound 24 26 80 120
## 5 Borzoi 26 28 70 100
## 6 Bullmastiff 25 27 100 130
## # … with abbreviated variable names ¹weight_low_lbs, ²weight_high_lbs
long <- Breed_Traits %>%
pivot_longer(cols = c(`Affectionate With Family`,`Good With Young Children`, `Good With Other Dogs`, `Shedding Level`, `Coat Grooming Frequency`, `Drooling Level`, `Openness To Strangers`, `Playfulness Level`, `Watchdog/Protective Nature`, `Adaptability Level`, `Trainability Level`, `Energy Level`, `Barking Level`, `Mental Stimulation Needs`), # variables in the new column
names_to = 'Traits', # new name of the column
values_to = 'Values') # name of the column
head(long)## # A tibble: 6 × 6
## Breed `Breed Group` `Coat Type` `Coat Length` Traits Values
## <chr> <chr> <chr> <chr> <chr> <dbl>
## 1 Retrievers (Labrador) Sporting Double Short Affectio… 5
## 2 Retrievers (Labrador) Sporting Double Short Good Wit… 5
## 3 Retrievers (Labrador) Sporting Double Short Good Wit… 5
## 4 Retrievers (Labrador) Sporting Double Short Shedding… 4
## 5 Retrievers (Labrador) Sporting Double Short Coat Gro… 2
## 6 Retrievers (Labrador) Sporting Double Short Drooling… 2
Traits_long <- long %>% # graph with this data
plot_ly(x = ~ `Breed Group`,
y = ~ Values,
color = ~ Traits,
type = "bar", # bar graph
marker = list(color = rainbow(nrow(long)))) %>% # bar graph is colored by rainbow
layout(title = 'Breed vs. Traits', # add a title
xanchor = 'center', # center the title
yanchor = 'top',
font = list(color = "darkorchid"), # change title color
plot_bgcolor = "white", # made background white
paper_bgcolor = "lavender", # paper background color
xaxis = list(title = 'Breed Group', # label x axis
tickangle = -45, # angle the x axis
color = "darkorchid", # color x axis
size = 15),# make the x axis smaller
yaxis = list(title = 'Rank', # label y axis
color = "darkorchid"), # color of y axis title
legend = list(title = list(text = '<b> Traits </b>', # rename legend
font = list(color = "darkorchid"), # change legend color
xanchor = 'center', # center the legend
yanchor = 'top')))
Traits_longcoat_filtered <- Breed_Traits %>%
filter(`Breed Group` %in% c("Hound","Sporting")) %>% # filter out breed group
filter(`Coat Type` %in% c("Smooth","Double")) %>%# filter out coat preference
filter(`Affectionate With Family` >= 3)%>% # filter following traits
filter(`Good With Other Dogs` >= 3) %>%
filter(`Trainability Level` >=3) %>%
filter(`Adaptability Level` >=3) %>%
filter(`Coat Length` == "Short") # filter by coat length
head(coat_filtered)## # A tibble: 6 × 18
## Breed Breed…¹ Affec…² Good …³ Good …⁴ Shedd…⁵ Coat …⁶ Drool…⁷ Coat …⁸ Coat …⁹
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Retri… Sporti… 5 5 5 4 2 2 Double Short
## 2 Beagl… Hound 3 5 5 3 2 1 Smooth Short
## 3 Point… Sporti… 5 5 4 3 2 2 Smooth Short
## 4 Dachs… Hound 5 3 4 2 2 2 Smooth Short
## 5 Britt… Sporti… 3 4 4 3 3 1 Double Short
## 6 Vizsl… Sporti… 5 5 4 3 2 2 Smooth Short
## # … with 8 more variables: `Openness To Strangers` <dbl>,
## # `Playfulness Level` <dbl>, `Watchdog/Protective Nature` <dbl>,
## # `Adaptability Level` <dbl>, `Trainability Level` <dbl>,
## # `Energy Level` <dbl>, `Barking Level` <dbl>,
## # `Mental Stimulation Needs` <dbl>, and abbreviated variable names
## # ¹`Breed Group`, ²`Affectionate With Family`, ³`Good With Young Children`,
## # ⁴`Good With Other Dogs`, ⁵`Shedding Level`, ⁶`Coat Grooming Frequency`, …
table <- coat_filtered %>%
plot_ly(
type = 'table', # type of graph
columnwidth = c(80), # column width
header = list(
values = c('<b>Breed</b>','<b>Affectionate With Family</b>','<b>Good With Other Dogs</b>','<b>Adaptability Level</b>','<b>Trainability Level</b>','<b>Coat Type</b>','<b>Coat Length</b>'), # column names
line = list(color = '#506784'), # line color
fill = list(color = '#119DFF'),# column name color
align = c('left','center'), # column names centered
font = list(color = 'white', size = 12) #column name title color
),
cells = list(
values = rbind(
c('Retrievers (Labrador)', 'Beagles', 'Pointers (German Shorthaired)', 'Dachshunds', 'Brittanys','Vizslas','Basset Hounds','Weimaraners','Rhodesian Ridgebacks','Bloodhounds','Whippets','Pointers','Black and Tan Coonhounds
','Bluetick Coonhounds','Greyhounds','Salukis','Redbone Coonhounds','Treeing Walker Coonhounds','Cirnechi dell’Etna','Pharaoh Hounds','American English Coonhounds','Sloughis','Harriers','American Foxhounds','English Foxhounds'), # row titles
c(5,3,5,5,3,5,3,5,5,4,5,5,4,3,4,5,5,5,4,5,3,4,5,3,5),
c(3,3,3,3,3,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5),
c(4,4,3,3,3,4,4,3,5,4,4,5,4,3,3,4,4,3,4,4,3,3,4,3,4),
c(5,4,4,3,3,5,4,5,5,3,4,5,3,3,3,5,3,4,3,5,4,3,4,3,4), # input values
c("Smooth","Smooth","Smooth","Smooth","Smooth","Smooth","Smooth","Double","Smooth","Smooth","Smooth","Double","Smooth","Smooth","Smooth","Smooth","Smooth","Smooth","Smooth","Smooth","Smooth","Smooth","Double","Smooth","Double"), # input coat type
c("Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short","Short")), # input coat length
line = list(color = '#506784'), # row line color
fill = list(color = c('#25FEFD', 'white')), # row fill color
align = c('left', 'center'), # row title alignment
font = list(color = c('#506784'), size = 12) # row text color and size
))
tableweight_f <- AKC_Breed_Info %>%
drop_na() %>%
filter(Breed %in% c("Whippet","Vizsla","Rhodesian Ridgeback","Labrador Retriever","German Shorthaired Pointer","Pharaoh Hound","Harrier","English Foxhound","Black And Tan Coonhound","Basset Hound","Beagle","Dachshund","Brittany","Weimarener","Bloodhound","Whippet","Basenji","Pointer","Greyhound","Redbone Coonhound")) %>% # filter data to be universal
filter(weight_low_lbs >= 45) %>% # look at weights greater than 45 lbs
filter(weight_high_lbs <= 100) # weight less than 100 lbs
head(weight_f)## # A tibble: 6 × 5
## Breed height_low_inches height_high_inc…¹ weigh…² weigh…³
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Black And Tan Coonhound 23 27 50 75
## 2 English Foxhound 22 25 65 70
## 3 German Shorthaired Pointer 20 27 50 80
## 4 Greyhound 27 30 60 70
## 5 Labrador Retriever 21 24 55 80
## 6 Rhodesian Ridgeback 24 27 70 85
## # … with abbreviated variable names ¹height_high_inches, ²weight_low_lbs,
## # ³weight_high_lbs
weight <- weight_f %>% # plot filtered data
plot_ly(x = ~ weight_low_lbs,
y = ~weight_high_lbs,
type = "scatter", # type of data
mode = "markers",
color = ~Breed, # color by
colors = "Set1", # color pattern
size = 20) %>% # size of the dot
layout(title = 'Breed vs. Weight', # title of plot
font = list(color = "black"), # title color
plot_bgcolor = "white",# plot color
paper_bgcolor = "thistle", # background color
xaxis = list(title = 'Low Weight Range', # x axis title
tickangle = -45, # angle x axis
color = "black"), # color x axis
yaxis = list(title = 'High Weight Range', # y axis title
color = "black"), # y axis color
legend = list(title = list(text = '<b> Breed </b>', # legend title
font = list(color = "black"), # legend color
xanchor = 'center', # center title
yanchor = 'top')))
weightheight_f <- weight_f %>%
filter(height_low_inches >= 21) %>% # filter by 21 inches and greataer
filter(height_high_inches <= 26) # filter by less than or equal to 26 inches
head(height_f)## # A tibble: 4 × 5
## Breed height_low_inches height_high_inches weight_low_lbs weigh…¹
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 English Foxhound 22 25 65 70
## 2 Labrador Retriever 21 24 55 80
## 3 Pharaoh Hound 21 25 45 55
## 4 Vizsla 22 25 48 66
## # … with abbreviated variable name ¹weight_high_lbs
height <- height_f%>% # plot filtered data
plot_ly(x = ~ height_low_inches,
y = ~height_high_inches,
type = "scatter", # type of data
mode = "markers",
color = ~Breed, # color by
colors = "Set1", # color pattern
size = 22)%>% # size of the dot
layout(title = 'Breed vs. Height', # title of plot
font = list(color = "black"), # title color
plot_bgcolor = "white",# plot color
paper_bgcolor = "thistle", # background color
xaxis = list(title = 'Low Height Range', # x axis title
tickangle = -45, # angle x axis
color = "black"), # color x axis
yaxis = list(title = 'High Height Range', # y axis title
color = "black"), # y axis color
legend = list(title = list(text = '<b> Breed </b>', # legend title
font = list(color = "black"), # legend color
xanchor = 'center', # center title
yanchor = 'top')))
heighttrait_filter <- long %>%
# mutate(Breed = trimws(Breed)) %>%
filter(Breed %in% c("English Foxhounds" ,"Retrievers (Labrador)","Pharaoh Hounds" ,"Vizslas")) %>% # look at these breeds
filter(Traits %in% c("Trainability Level","Adaptability Level","Good With Other Dogs","Affectionate With Family")) # look at these traits
head(trait_filter)## # A tibble: 6 × 6
## Breed `Breed Group` `Coat Type` `Coat Length` Traits Values
## <chr> <chr> <chr> <chr> <chr> <dbl>
## 1 Retrievers (Labrador) Sporting Double Short Affectio… 5
## 2 Retrievers (Labrador) Sporting Double Short Good Wit… 5
## 3 Retrievers (Labrador) Sporting Double Short Adaptabi… 5
## 4 Retrievers (Labrador) Sporting Double Short Trainabi… 5
## 5 Vizslas Sporting Smooth Short Affectio… 5
## 6 Vizslas Sporting Smooth Short Good Wit… 4
final <- trait_filter %>% # data used
plot_ly(x = ~ Traits,
y = ~Values,
type = "bar", # type of graph
mode = "markers",
color = ~Breed, # color by
colors = "Paired") %>% # color pattern
layout(title = 'Final Breed vs. Preferred Traits', # plot title
font = list(color = "darkred"), # title color
plot_bgcolor = "bisque", # color of plot
paper_bgcolor = "bisque", # color of background
xaxis = list(title = 'Traits', # x axis title
tickangle = -45, # angle x axis
color = "darkred"), # x axis color
yaxis = list(title = 'Rank',# y axis title
color = "darkred"), # y axis color
legend = list(title = list(text = '<b> Breed </b>', # legend title
font = list(color = "darkred"), # legend color
xanchor = 'center', # title centered
yanchor = 'top')))
finalLab <- image_read("https://patchpuppy.com/wp-content/uploads/2022/05/AreEnglishLabsGoodDogs.jpg") # read in image
image_border(Lab, color = "chocolate4",
geometry = "26x28") %>% # Add a border
image_annotate("Labrador Retriever", font = 'Palatino',
size = 50,
gravity = "southwest",
color = "white",
boxcolor = "chocolate4") # add text box